C     Program EX_0702.FOR
C     Listing 15F - see documentation in TUTOR.SSS
 
$include:'SSSF1.H'
 
      subroutine prime
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  MAINP, COVER, MREQ, server
      real*8  WHITE, BLUE, RED, YELLOW
      common  ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  WHITE, BLUE, RED, YELLOW, MAINP, COVER, MREQ,
     +  server
 
      ARRIVL = 1
      STARTA = 2
      ENDACT = 3
      NEXTAC = 4
      MATCH  = 5
 
      WHITE  = 1.0
      BLUE   = 2.0
      RED    = 3.0
      YELLOW = 4.0
      MAINP  = 1
      COVER  = 2
      MREQ   = 3
      server = 1

      call INIQUE(2, 1, 1)
      call SIMEND(150.0)
      call CREATE(EX(12.0), MAINP)
      call CREATE(EX(12.0), COVER)
      return
      end
 
      integer function other
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  MAINP, COVER, MREQ, server
      real*8  WHITE, BLUE, RED, YELLOW
      common  ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  WHITE, BLUE, RED, YELLOW, MAINP, COVER, MREQ,
     +  server
 
      if (IDE().eq.MAINP) then
        other = COVER
      else
        other = MAINP
      endif
      return
      end

      subroutine find1
$include:'SSSF2.H'
 
      integer ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  MAINP, COVER, MREQ, server
      real*8  WHITE, BLUE, RED, YELLOW
      common  ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  WHITE, BLUE, RED, YELLOW, MAINP, COVER, MREQ,
     +  server
      integer o, other
 
      i = 1
      o = other()
 99   continue
      if ((i.lt.NQ(o)).and.(AIQ(o, i, 1).ne.A(1))) then
        i = i + 1
        goto 99
      endif
 
      if (i.le.NQ(o)) then
        call DISPOS
        call REMVFQ(o, i)
        call SCHED(0.0, STARTA, IDE())
      else
        call QUEUE(IDE(), 0.0)
      endif
      return
      end
 
      subroutine find2
$include:'SSSF2.H'

      integer ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  MAINP, COVER, MREQ, server
      real*8  WHITE, BLUE, RED, YELLOW
      common  ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  WHITE, BLUE, RED, YELLOW, MAINP, COVER, MREQ,
     +  server
      logical found
      real*8  color
 
      found = .FALSE.
      j = 1
  99  continue
        color = AIQ(MAINP, j, 1)
        i = 1
  88    continue
        if ((i.lt.NQ(COVER)).and.
     +      (AIQ(COVER, i, 1).ne.color)) then
          i = i + 1
          goto 88
        endif
 
        if (i.le.NQ(COVER)) then
          call REMVFQ(COVER, i)
          call DISPOS
          call REMVFQ(MAINP, j)
          found = .TRUE.
        else
          j = j + 1
        endif
      if ((.not.found).and.(j.le.NQ(MAINP))) goto 99
      return
      end
 
      Program EX_0702
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  MAINP, COVER, MREQ, server
      real*8  WHITE, BLUE, RED, YELLOW
      common  ARRIVL, STARTA, ENDACT, NEXTAC, MATCH,
     +  WHITE, BLUE, RED, YELLOW, MAINP, COVER, MREQ,
     +  server
      integer ecode, other
 
      call prime
 
   99 ecode = NEXTEV()
      if (ecode.gt.0) then
        goto (101, 102, 103, 104, 105) ecode
 
C ARRIVL
  101   continue
        if (IDE().eq.MREQ) then
          call SCHED(0.0, MATCH, IDE())
 
        else
          call CREATE(EX(12), IDE())
          if (RA().lt.0.35) then
            call SETA(1, WHITE )
          elseif (RA().lt.0.50) then
            call SETA(1, BLUE  )
          elseif (RA().lt.0.80) then
            call SETA(1, RED   )
          else
            call SETA(1, YELLOW)
          endif
 
          call SCHED(0.0, NEXTAC, IDE())
        endif
        goto 99
 
C NEXTAC
  104   continue
        if ((server.gt.0).and.(NQ(other()).gt.0)) then
          call SCHED(0.0, MATCH, IDE())
        else
          call QUEUE(IDE(), 0.0)
        endif
        goto 99
 
C MATCH
  105   continue
        if (IDE().eq.MREQ) then
          call DISPOS
          call find2
        else
          call find1
          if (NCEN().gt.0)
     +      call SCHED(0.0, STARTA, IDE())
        endif
        goto 99
 
C STARTA
  102   continue
        server = server - 1
        call SCHED(RN(10.0, 2.0), ENDACT, IDE())
        goto 99
 
C ENDACT
  103   continue
        call DISPOS
        server = server + 1
        if ((NQ(MAINP).gt.0).and.(NQ(COVER).gt.0))
     +    call CREATE(0.0, MREQ)
        goto 99
 
      else
 
        call SUMRY(' ')
        stop 'End of simulation'
 
      endif
      end
